PC Answers 1995 May/PC Answers CD-ROM 7 (Future Publishing) (May 1995).iso/vbits/code/appleman/evtprog2.frm

Visual Basic Form | 1994-10-06 | 6.6 KB | 221 lines

VERSION 2.00
Begin Form Form1
   Caption         =   "Designing Event Driven Code"
   ClientHeight    =   3900
   ClientLeft      =   1095
   ClientTop       =   1485
   ClientWidth     =   5580
   Height          =   4305
   Left            =   1035
   LinkTopic       =   "Form1"
   ScaleHeight     =   3900
   ScaleWidth      =   5580
   Top             =   1140
   Width           =   5700
   Begin CommandButton Command7
      Caption         =   "Cancel Timer"
      Height          =   435
      Left            =   3060
      TabIndex        =   7
      Top             =   3360
      Width           =   1755
   End
   Begin Timer Timer1
      Enabled         =   0   'False
      Interval        =   1
      Left            =   180
      Top             =   2940
   End
   Begin CommandButton Command6
      Caption         =   "With Timer"
      Height          =   435
      Left            =   3060
      TabIndex        =   6
      Top             =   2880
      Width           =   1755
   End
   Begin CommandButton Command5
      Caption         =   "With DoEvents III"
      Height          =   495
      Left            =   3060
      TabIndex        =   5
      Top             =   2340
      Width           =   1755
   End
   Begin CommandButton Command4
      Caption         =   "With DoEvents II"
      Height          =   495
      Left            =   3060
      TabIndex        =   4
      Top             =   1800
      Width           =   1755
   End
   Begin CommandButton Command3
      Caption         =   "With DoEvents"
      Height          =   495
      Left            =   3060
      TabIndex        =   3
      Top             =   1260
      Width           =   1755
   End
   Begin CommandButton Command2
      Caption         =   "Escape Check"
      Height          =   495
      Left            =   3060
      TabIndex        =   2
      Top             =   720
      Width           =   1695
   End
   Begin CommandButton Command1
      Caption         =   "No DoEvents"
      Height          =   495
      Left            =   3060
      TabIndex        =   1
      Top             =   180
      Width           =   1695
   End
   Begin Label Label1
      BackColor       =   &H00FFFFFF&
      Caption         =   "Label1"
      FontBold        =   -1  'True
      FontItalic      =   0   'False
      FontName        =   "MS Sans Serif"
      FontSize        =   24
      FontStrikethru  =   0   'False
      FontUnderline   =   0   'False
      Height          =   675
      Left            =   300
      TabIndex        =   0
      Top             =   420
      Width           =   2295
   End
Option Explicit
' With no events allowed, not only are further clicks
' not acted upon, but they are queued up for later - leaving
' to results confusing to the user.
Sub Command1_Click ()
    Dim x&
    For x& = 1 To LOOPCOUNT
        If x& = 500 Then ToggleColor
        label1.Caption = Str$(x&)
        label1.Refresh
    Next x&
End Sub
' A classic DOS approach is to check for a key such as
' the escape key.  But this still allows queued events
' to pile up.
Sub Command2_Click ()
    Dim x&
    Dim EscapeKey%
    ' Clear the current state
    EscapeKey% = GetAsyncKeyState(VK_ESCAPE)
    For x& = 1 To LOOPCOUNT
        If x& = 500 Then ToggleColor
        label1.Caption = Str$(x&)
        label1.Refresh
        EscapeKey% = GetAsyncKeyState(VK_ESCAPE)
        If EscapeKey% And 1 Then Exit Sub
    Next x&
End Sub
' This time we place a DoEvents to allow events to be
' processed - but note the reentrancy problem!
Sub Command3_Click ()
    Dim x&
    For x& = 1 To LOOPCOUNT
        label1.Caption = Str$(x&)
        If x& = 500 Then ToggleColor
        ' Note - we don't need the refresh any more
        DoEvents
    Next x&
End Sub
' We can prevent reentrancy problems by disabling the form
Sub Command4_Click ()
    Dim x&
    ' The easy way is to disable the entire form
    Form1.Enabled = False
    ' Alternatively, you can disable each control
    ' individually (it would look better)
    For x& = 1 To LOOPCOUNT
        label1.Caption = Str$(x&)
        If x& = LOOPCOUNT Then ToggleColor
        ' Note - we don't need the refresh any more
        DoEvents
    Next x&
    ' And be sure to reenable the form when done
    Form1.Enabled = True
End Sub
' The disabling might look better if we do it one control
' at a time
Sub Command5_Click ()
    Dim x&
    Dim ctlnum%
    ' Alternatively, you can disable each control
    ' individually (it would look better)
    For ctlnum% = 0 To Controls.Count - 1
        If TypeOf Controls(ctlnum%) Is CommandButton Then
            Controls(ctlnum%).Enabled = False
        End If
    Next ctlnum%
    For x& = 1 To LOOPCOUNT
        label1.Caption = Str$(x&)
        If x& = LOOPCOUNT Then ToggleColor
        ' Note - we don't need the refresh any more
        DoEvents
    Next x&
    ' And be sure to reenable the controls when done
    For ctlnum% = 0 To Controls.Count - 1
        If TypeOf Controls(ctlnum%) Is CommandButton Then
            Controls(ctlnum%).Enabled = True
        End If
    Next ctlnum%
    Form1.Enabled = True
End Sub
' Reset the counter, and begin the count
Sub Command6_Click ()
    Dim di%
    di% = PerformCount(0)
    timer1.Enabled = True
End Sub
' Stop the counter
Sub Command7_Click ()
    timer1.Enabled = False
End Sub
' This is a function designed to be reentrant without being
' recursive.
' mode is 0 to initialize the counter
' mode is 1 to continue counting
' Return value is 0 if counting is finished
' Return value is 1 to continue counting
Function PerformCount% (mode As Integer)
    Static counter&
    Select Case mode
        Case 0
                counter& = 0
        Case 1
                counter& = counter& + 1
    End Select
    If counter& = LOOPCOUNT Then
        ToggleColor
        PerformCount% = 0
    Else
        PerformCount% = 1
    End If
    label1.Caption = Str$(counter&)
End Function
Sub Timer1_Timer ()
    Dim res%
    res% = PerformCount(1)
    ' Once the termination condition is reached, shut off
    ' the timer
    If res% = 0 Then timer1.Enabled = False
End Sub
' This function toggles the background color of the label
' to make it easier to see when the count ends
Sub ToggleColor ()
    If label1.BackColor = QBColor(15) Then
        label1.BackColor = QBColor(11)
    Else
        label1.BackColor = QBColor(15)
    End If
End Sub